#lang racket


(require "ac-com.rkt")

(provide
 ; constants
 view-front
 view-neiso
 view-nwiso
 view-seiso
 view-swiso
 vscurrent-conceptual
 zoom-extents
 
 ; commands
 arc-ppp-command
 cone-frustrum-command
 entlast-command
 erase-all-command
 dview-command
 join-command
 loft-command
 redo-command
 regen-command
 render-command
 sweep-command
 undo-command
 vscurrent-command
 zoom-command
 
 ; high-level commands
 auto-view-command
 set-view-command)


; constants

(define view-front "_front")
(define view-neiso "_neiso")
(define view-nwiso "_nwiso")
(define view-seiso "_seiso")
(define view-swiso "_swiso")
(define vscurrent-conceptual "_Conceptual")
(define zoom-extents "_e")


; lisp

(define (cone-frustrum-lisp c base-radius top-radius height)
  (string-append
   "._cone "
   (format "~A,~A,~A " (vector-ref c 0) (vector-ref c 1) (vector-ref c 2))
   (format "~A _T ~A ~A " base-radius top-radius height)))

(define (dview-lisp center target lens distance)
  (format "._dview  _z ~A _po ~A ~A _d ~A" lens target center distance))

(define (handent-lisp handle)
  (string-append "(handent \"" handle "\")"))

(define (join-lisp objects)
  (apply
   string-append
   "._join "
   (map
    (λ (entity)
      (format "~A " (handent-lisp (get-object-handle entity))))
    objects)))

(define (loft-lisp objects)
  (string-append
   "._loft "
   (apply
    string-append
    (map
     (λ (object)
       (string-append (handent-lisp (get-object-handle object)) " "))
     objects))
   vbCr))

(define coord-lisp
  (case-lambda
    ((x y)
     (format "~A,~A" x y))
    ((x y z)
     (format "~A,~A,~A" x y z))))

(define (render-lisp width height filename)
  (format "._-render P R ~A ~A yes ~A" width height filename))

(define (view-lisp name)
  (format "._-view ~A" name))

(define (vscurrent-lisp name)
  (format "._vscurrent ~A" name))

(define (zoom-lisp name)
  (format "._zoom ~A" name))


; commands

(define (arc-ppp-command c1 c2 c3)
  (send-command
   (string-append
    "._arc "
    (format "~A,~A,~A " (vector-ref c1 0) (vector-ref c1 1) (vector-ref c1 2))
    (format "~A,~A " (vector-ref c2 0) (vector-ref c2 1))
    (format "~A,~A " (vector-ref c3 0) (vector-ref c3 1))))
  (entlast-command))

(define (cone-frustrum-command c base-radius top-radius height)
  (send-command
   (cone-frustrum-lisp c base-radius top-radius height))
  (entlast-command))

(define (entlast-command)
  (item (- (get-modelspace-count) 1)))

(define (dview-command center target lens distance)
  (send-command (string-append (dview-lisp center target lens distance) vbCr)))

(define (erase-all-command)
  (send-command (string-append "erase all" vbCr)))

(define (join-command objects)
  (send-command
   (format "~A " (join-lisp objects)))
  (entlast-command))

(define (loft-command closed? objects)
  (let ((loft-param (get-loft-param-variable)))
    (set-loft-param-variable (if closed? '(close) loft-param))
    (send-command (loft-lisp objects))
    (set-loft-param-variable loft-param)
    (entlast-command)))

(define (redo-command)
  (send-command (string-append "redo" vbCr)))

(define (regen-command)
  (send-command (string-append "regen" vbCr)))

(define (render-command width height filename)
  (send-command (string-append (render-lisp width height filename) "\n")))

(define (sweep-command object path)
  (send-command
   (string-append
    "sweep "
    (handent-lisp (get-object-handle object))
    vbCr
    (handent-lisp (get-object-handle path))
    " ")))

(define (undo-command)
  (send-command (string-append "undo" vbCr)))

(define (view-command name)
  (send-command (string-append (view-lisp name) " ")))

(define (vscurrent-command name)
  (send-command (string-append (vscurrent-lisp name) " ")))

(define (zoom-command name)
  (send-command (string-append (zoom-lisp name) " ")))


; high-level commands

(define (auto-view-command direction-x direction-y direction-z perspective lens)
  (vscurrent-command vscurrent-conceptual)
  (dview-command
   (coord-lisp (- direction-x) (- direction-y) (- direction-z))
   (coord-lisp 0 0 0)
   lens
   1.0)
  (set-perspective-variable perspective)
  (zoom-command zoom-extents))

(define (set-view-command center-x center-y center-z target-x target-y target-z perspective lens distance)
  (vscurrent-command vscurrent-conceptual)
  (dview-command
   (coord-lisp center-x center-y center-z)
   (coord-lisp target-x target-y target-z)
   lens
   distance)
  (set-perspective-variable perspective))